home *** CD-ROM | disk | FTP | other *** search
/ Amiga Game-Power / Amiga Game-Power.iso / anwendungen / videodatei / maxidat / maxidat_v2.20 (.txt) < prev    next >
AmigaBASIC Source Code  |  1994-05-20  |  21KB  |  987 lines
  1. REM ***********************
  2. REM *** Dateiverwaltung ***
  3. REM ***********************
  4. REM *** MaxiDAT Ver2.10 ***
  5. REM ***   written by    ***
  6. REM *** Christoph  Hust ***
  7. REM ***      in         ***
  8. REM ***    Mai 1989     ***
  9. REM ***********************
  10.  
  11. REM *********************************
  12. REM *** H a u p t p r o g r a m m ***
  13. REM *********************************
  14.  
  15. DECLARE FUNCTION DisplayAlert% LIBRARY
  16.  
  17. SCREEN 1,640,400,2,2
  18.  
  19. WINDOW 2,"             * * * * *   M a x i D A T   V  2 . 2 0   * * * * *",,16,1
  20.  
  21. WIDTH 78
  22.  
  23. ON BREAK GOSUB Ende
  24. BREAK ON
  25.  
  26. ON ERROR GOTO Fehler
  27.  
  28. INPUT "Drucker vorhanden (J/N) ";D$
  29. CLS
  30. PRINT "Bitte etwas Geduld! Libraries werden geladen!!"
  31. IF LEFT$(UCASE$(D$),1)="J" THEN
  32.   Drucker=1
  33. END IF
  34.  
  35. LIBRARY "graphics.library"
  36. LIBRARY "intuition.library"
  37.  
  38. Version$="Ver. 2.20, 13. 05. 1989"
  39.  
  40. OPEN "mConfig" FOR INPUT AS #1
  41.   INPUT #1,x$
  42.   INPUT #1,Drive$
  43.   INPUT #1,Pfad$
  44.   INPUT #1,d1$
  45.   INPUT #1,d2$
  46.   FOR I=0 TO 3
  47.     INPUT #1,r,g,b
  48.     PALETTE I,r,g,b
  49.   NEXT I
  50. CLOSE #1
  51.  
  52. IF Drucker=1 THEN
  53.   LPRINT
  54. END IF
  55.  
  56. DIM Laenge(11),Bezeichnung$(11),In$(11),Ein$(11)
  57.  
  58. MENU 1,0,1,"Projekt  "
  59. MENU 1,1,1,"Datei einrichten "
  60. MENU 1,2,1,"Daten eingeben   "
  61. MENU 1,3,1,"Datei benutzen   "
  62. MENU 1,4,1,"Neustart         "
  63. MENU 1,5,0,"-----------------"
  64. MENU 1,6,1,"Ende             "
  65.  
  66. MENU 2,0,Drucker,"Drucker  "
  67. MENU 2,1,1,"Alles ausdrucken MIT  "
  68. MENU 2,2,1,"Alles ausdrucken OHNE "
  69. MENU 2,3,1,"Auswahl ausdrucken    "
  70.  
  71. MENU 3,0,1,"Disk  "
  72. MENU 3,1,1,"Momentanes Directory ändern "
  73. MENU 3,2,1,"Diskettenlaufwerk ändern    "
  74. MENU 3,3,1,"Inhalt anzeigen             "
  75. MENU 3,4,1,"Datei löschen               "
  76.  
  77. MENU 4,0,1,"Grafik  "
  78. MENU 4,1,1,"Datei anlegen   "
  79. MENU 4,2,1,"Grafik zeichnen "
  80.  
  81. MENU 5,0,1,"Infos  "
  82. MENU 5,1,1,"Programminfo "
  83.  
  84. RastPort&=WINDOW(8)
  85.  
  86. Hauptprogramm:
  87.              
  88. ON MENU GOSUB Men
  89. MENU ON
  90.  
  91. ON TIMER(1) GOSUB Zeit
  92.  
  93. Hauptschleife:
  94.   MENU ON
  95.   CLS
  96.   TIMER ON
  97.   COLOR 1
  98.   LOCATE 1,1
  99.   Txt$="    Dateiverwaltung AMIGA"
  100.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  101.   LOCATE 2,1
  102.   Txt$="   -----------------------"
  103.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  104.   LOCATE 4,1
  105.   Txt$=" Version : "+Version$
  106.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  107.   GOSUB Datum
  108.   LOCATE 6,1
  109.   Txt$="  Heutiges Datum : "+DTM$
  110.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  111.   SchreibeZeit:
  112.   LOCATE 7,1
  113.   Txt$="  Uhrzeit        : "+TIME$
  114.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  115.   SLEEP
  116.   SLEEP
  117.   dummy$=INKEY$
  118. GOTO Hauptschleife
  119.                                                                  
  120. Zeit:
  121. RETURN SchreibeZeit
  122.  
  123. REM *********************************************************
  124. REM *** Dieses Unterprogramm wertet die MENU-Funktion aus ***
  125. REM *** und verzweigt dann zu den ausgewählten Funktionen ***
  126. REM *********************************************************
  127.  
  128. Men:
  129.   TIMER OFF
  130.   Titel=MENU(0)
  131.   Punkt=MENU(1)
  132.   IF Titel=1 THEN
  133.     IF Punkt=1 THEN
  134.       GOSUB Einrichten
  135.     END IF
  136.     IF Punkt=2 THEN
  137.       GOSUB Eingabe
  138.     END IF
  139.     IF Punkt=3 THEN
  140.       GOSUB Benutzen
  141.     END IF
  142.     IF Punkt=4 THEN
  143.       GOSUB Loeschen
  144.     END IF
  145.     IF Punkt=6 THEN
  146.       GOSUB Ende
  147.     END IF
  148.   END IF
  149.   IF Titel=2 THEN
  150.     IF Punkt=1 THEN
  151.       GOSUB DruckeAlles
  152.     END IF
  153.     IF Punkt=2 THEN
  154.       GOSUB DruckeAllesOHNE
  155.     END IF
  156.     IF Punkt=3 THEN
  157.       GOSUB DruckeAuswahl
  158.     END IF
  159.   END IF
  160.   IF Titel=3 THEN
  161.     IF Punkt=1 THEN
  162.       GOSUB ChangeDir
  163.     END IF
  164.     IF Punkt=2 THEN
  165.       GOSUB ChangeDrive
  166.     END IF
  167.     IF Punkt=3 THEN
  168.       GOSUB ZeigeDir
  169.     END IF
  170.     IF Punkt=4 THEN
  171.       GOSUB DeleteFile
  172.     END IF
  173.   END IF
  174.   IF Titel=4 THEN
  175.     IF Punkt=1 THEN
  176.       GOSUB GrafikdateiAnlegen
  177.     END IF
  178.     IF Punkt=2 THEN
  179.       GOSUB Zeichnen
  180.     END IF
  181.   END IF
  182.   IF Titel=5 THEN
  183.     GOSUB ProgrammInfo
  184.   END IF
  185. RETURN
  186.  
  187. REM ********************************************
  188. REM *** Hier beginnen die Programmfunktionen ***
  189. REM ********************************************
  190.  
  191. Einrichten:
  192.   GOSUB LoescheVariablen
  193.   WHILE Jn$<>"J"
  194.     Gesamtlaenge = 0
  195.     CLS
  196.     MENU OFF
  197.     PRINT :PRINT 
  198.     FOR I=1 TO 11
  199.       LOCATE I+2,1
  200.       PRINT USING "##";I
  201.       COLOR 1,2
  202.       LOCATE 1,1
  203.       PRINT "BITTE BEZEICHNUNG EINGEBEN. * = Ende.     "    
  204.       COLOR 1,0
  205.       LOCATE I+2,4
  206.       PRINT Bezeichnung$(I);
  207.       LOCATE I+2,4
  208.       LINE INPUT NeueBezeichnung$
  209.       NeueBezeichnung$=LEFT$(NeueBezeichnung$,40)
  210.       IF NeueBezeichnung$<>"" THEN
  211.         Bezeichnung$(I)=NeueBezeichnung$
  212.       END IF
  213.       BeLaenge=LEN(Bezeichnung$(I))
  214.       IF BeLaenge>Maxbezlaenge THEN
  215.         Maxbezlaenge=BeLaenge
  216.       END IF
  217.       LOCATE I+2,4
  218.       PRINT Bezeichnung$(I)
  219.       PRINT STRING$(20," ")
  220.       COLOR 1,2
  221.       LOCATE 1,1
  222.       PRINT "BITTE MAXIMALE LÄNGE DER EINGABE EINGEBEN."  
  223.       COLOR 1,0
  224.       LOCATE I+2,42
  225.       PRINT Laenge(I)
  226.       LOCATE I+2,42
  227.       LINE INPUT Laenge$
  228.       NeueLaenge=INT(VAL(Laenge$))
  229.       IF NeueLaenge<>0 THEN
  230.         Laenge(I)=NeueLaenge
  231.       END IF  
  232.       Fertig=0
  233.       IF Bezeichnung$(I)="*" THEN
  234.         Anzmsk=I
  235.         Fertig=1
  236.       END IF
  237.       IF Laenge(I)<=0 OR Laenge(I)>50 THEN
  238.         Laenge(I)=45
  239.       END IF
  240.       IF Fertig THEN
  241.         I=16
  242.       END IF
  243.     NEXT I
  244.     CLS
  245.     FOR I=1 TO 11
  246.       LOCATE I+2,1
  247.       PRINT USING "##";I;
  248.       LOCATE I+2,4
  249.       Txt$=Bezeichnung$(I)
  250.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  251.       LOCATE I+2,42
  252.       Txt$=STR$(Laenge(I))
  253.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  254.     NEXT I
  255.     Anzmsk=Anzmsk-1
  256.     Jn$=""
  257.     LOCATE 1,1
  258.     PRINT "SIND DIESE EINGABEN RICHTIG   (J für JA, N für NEIN) ?";
  259.     LINE INPUT "";Jn$
  260.     Jn$=LEFT$(UCASE$(Jn$),1)
  261.   WEND
  262.   Jn$=""                            ' fuer naechsten Aufruf loeschen
  263.   CLS
  264.   LOCATE 1,1
  265.   PRINT "Bitte geben Sie den Namen für die neue Datei ein !"
  266.   LINE INPUT Datinfnam$
  267.   IF Datinfnam$<>"" THEN
  268.     Datinfnam$="Daten/"+Datinfnam$+".INFOS"
  269.     OPEN Datinfnam$ FOR OUTPUT AS #2
  270.       WRITE #2,Maxbezlaenge
  271.       WRITE #2,Anzmsk
  272.       WRITE #2,1                        ' Satznummer
  273.       FOR I=1 TO Anzmsk
  274.         WRITE #2,Bezeichnung$(I)
  275.         WRITE #2,Laenge(I)
  276.       NEXT I
  277.     CLOSE #2          
  278.   END IF
  279. RETURN             
  280.  
  281. Eingabe:
  282.   GOSUB LoescheVariablen
  283.   CLS
  284.   LINE INPUT "Name der Datei ? ";Datnam$
  285.   IF Datnam$="" THEN
  286.     RETURN
  287.   END IF
  288.   Datinfnam$=Drive$+Pfad$+Datnam$+".INFOS"
  289.   Datnam$=Drive$+Pfad$+Datnam$+".DATEN"
  290.   GOSUB LeseInfos
  291.   Satz=Satznummer
  292.   OPEN "r",#1,Datnam$,550
  293.     FIELD #1,Laenge(1) AS In$(1),Laenge(2) AS In$(2),Laenge(3) AS In$(3),Laenge(4) AS In$(4),Laenge(5) AS In$(5),Laenge(6) AS In$(6),Laenge(7) AS In$(7),Laenge(8) AS In$(8),Laenge(9) AS In$(9),Laenge(10) AS In$(10),Laenge(11) AS In$(11)
  294.     WHILE Jn2$<>"N"
  295.       GOSUB Eing
  296.       FOR I=1 TO 11
  297.         LSET In$(I)=Ein$(I)
  298.         Ein$(I)=""
  299.       NEXT I
  300.       PUT #1,Satz
  301.       Satz=Satz+1
  302.       LOCATE 20,1
  303.       Jn2$=""
  304.       INPUT "Weiteren Datensatz eingeben ";Jn2$
  305.       Jn2$=LEFT$(UCASE$(Jn2$),1)
  306.     WEND
  307.     Jn2$=""
  308.   CLOSE #1
  309.   OPEN Datinfnam$ FOR OUTPUT AS #2
  310.     WRITE #2,Maxbezlaenge
  311.     WRITE #2,Anzmsk
  312.     WRITE #2,Satz
  313.     FOR I=1 TO Anzmsk
  314.       WRITE #2,Bezeichnung$(I)
  315.       WRITE #2,Laenge(I)
  316.     NEXT I
  317.   CLOSE #2  
  318. RETURN
  319.  
  320. Benutzen:
  321.   GOSUB LoescheVariablen
  322.   CLS
  323.   LINE INPUT "Name der Datei ? ";Datnam$
  324.   IF Datnam$="" THEN
  325.     RETURN
  326.   END IF
  327.   RastPort&=WINDOW(8)
  328.   Datinfnam$=Drive$+Pfad$+Datnam$+".INFOS"
  329.   Datnam$=Drive$+Pfad$+Datnam$+".DATEN"
  330.   GOSUB LeseInfos
  331.   Msatz=Satznummer-1
  332.   OPEN "r",#1,Datnam$,550
  333.     FIELD #1,Laenge(1) AS In$(1),Laenge(2) AS In$(2),Laenge(3) AS In$(3),Laenge(4) AS In$(4),Laenge(5) AS In$(5),Laenge(6) AS In$(6),Laenge(7) AS In$(7),Laenge(8) AS In$(8),Laenge(9) AS In$(9),Laenge(10) AS In$(10),Laenge(11) AS In$(11)
  334.     Satz=1
  335.     WHILE Co$<>"Q"
  336.       CLS
  337.       Co$=""
  338.       Txt$="Aktuelle Datei : "+Datnam$+"      Datensatz : "+STR$(Satz)
  339.       LOCATE 1,1
  340.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  341.       Txt$="***---------------------===MaxiDAT - Befehle===-------------------------***"
  342.       LOCATE 2,1
  343.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  344.       Txt$="<+> : Nächster Datensatz    <->    : Letzter Datensatz <G> : Spring zu Satz"
  345.       LOCATE 3,1
  346.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  347.       Txt$="<S> : Suche Daten           <HELP> : Kurze Info        <E> : Satz editieren"
  348.       LOCATE 4,1
  349.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  350.       Txt$="<L> : Lösche Datensatz      <D>    : Satz ausdrucken   <Q> : Hauptmenü"
  351.       LOCATE 5,1
  352.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  353.       Txt$="***---------------------=======================-------------------------***"
  354.       LOCATE 6,1
  355.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  356.       PRINT 
  357.       GET #1,Satz
  358.       FOR I=1 TO Anzmsk
  359.         COLOR 3
  360.         Txt$=Bezeichnung$(I)+":"
  361.         LOCATE I+7,1
  362.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  363.         COLOR 2
  364.         LOCATE I+7,Maxbezlaenge+4
  365.         Txt$=In$(I)
  366.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  367.       NEXT I
  368.       COLOR 1
  369.       WHILE Co$<>"+" AND Co$<>"-" AND Co$<>"G" AND Co$<>"S" AND Co$<>"R" AND Co$<>"L" AND Co$<>"E" AND Co$<>"D" AND Co$<>"Q" AND Co$<>CHR$(139) AND Co$<>CHR$(31) AND Co$<>CHR$(30)
  370.         Co$=UCASE$(INKEY$)
  371.       WEND
  372.       IF Co$=CHR$(139) THEN
  373.         REM 139 ist der ASCII-Code der HELP-Taste
  374.         CLS
  375.         Txt$="Bedienungsinfos für den Datei-Lesen-Teil von MaxiDAT"
  376.         LOCATE 1,1
  377.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  378.         Txt$="<+>   -   Der numerisch nächste Datensatz wird angezeigt"
  379.         LOCATE 4,1
  380.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  381.         Txt$="<->   -   Der numerisch letzte Datensatz wird angezeigt"
  382.         LOCATE 6,1
  383.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  384.         Txt$="<G>   -   Sie werden nach der Nummer des gewünschten
  385.         LOCATE 8,1
  386.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  387.         Txt$="          Datensatzes gefragt"
  388.         LOCATE 9,1
  389.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  390.         Txt$="<S>   -   Geben Sie die Nummer des Feldes und dann den"
  391.         LOCATE 11,1
  392.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  393.         Txt$="          Suchbegriff an. MaxiDAT sucht vom momentanen"
  394.         LOCATE 12,1
  395.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  396.         Txt$="          Datensatz bis zum Schluß (Großschreibung ist berücksichtigbar)"
  397.         LOCATE 13,1
  398.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  399.         Txt$="<E>   -   Sie können die Daten des aktuellen Satzes edi-"
  400.         LOCATE 15,1
  401.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  402.         Txt$="          tieren."
  403.         LOCATE 16,1
  404.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  405.         Txt$="<L>   -   Der Inhalt des aktuellen Datensatzes wird gelöscht."
  406.         LOCATE 18,1
  407.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  408.         Txt$="<D>   -   Der aktuelle Datensatz wird ausgedruckt."
  409.         LOCATE 20,1
  410.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  411.         Txt$="<Q>   -   Sie verlassen diesen Programmteil und kommen zurück"
  412.         LOCATE 22,1
  413.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  414.         Txt$="          zum Hauptmenü."
  415.         LOCATE 23,1
  416.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  417.         Txt$="<-    -   10 Sätze zurück"
  418.         LOCATE 25,1
  419.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  420.         Txt$="->    -   10 Sätze vorwärts"
  421.         LOCATE 27,1
  422.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  423.         Txt$="<HELP>-   Diese Seite"
  424.         LOCATE 29,1
  425.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  426.         Txt$="--- Beliebige Taste ---"
  427.         LOCATE 32,1
  428.         CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  429.         WHILE INKEY$=""
  430.         WEND
  431.       END IF
  432.       IF Co$="S" THEN
  433.         LOCATE 25,1
  434.         INPUT "In welchem Feld ";Sfeld
  435.         LINE INPUT "Nach welchem Begriff ? ";Such$
  436.         INPUT "Groß-/Kleinschreibung unterscheiden [j/n] ";Gk$
  437.         Gk$=UCASE$(LEFT$(Gk$,1))
  438.         IF Gk$="N" THEN
  439.           Gk=1
  440.           Such$=UCASE$(Such$)
  441.         ELSE
  442.           Gk=0
  443.         END IF
  444.         FOR I=Satz TO Msatz
  445.           GET #1,I
  446.           IF Gk THEN
  447.             Hier$=UCASE$(In$(Sfeld))
  448.           END IF
  449.           IF INSTR(Hier$,Such$) THEN
  450.             Satz=I
  451.             I=Msatz+1
  452.           END IF
  453.         NEXT I
  454.       END IF
  455.       IF Co$="+" THEN
  456.         IF Satz<Msatz THEN
  457.           Satz=Satz+1
  458.         ELSE
  459.           BEEP
  460.         END IF
  461.       END IF
  462.       IF Co$="-" THEN
  463.         IF Satz>1 THEN
  464.           Satz=Satz-1
  465.         ELSE
  466.           BEEP
  467.         END IF
  468.       END IF
  469.       IF Co$=CHR$(31) THEN
  470.         Satz=Satz-10
  471.         IF Satz<=0 THEN
  472.           BEEP
  473.           Satz=1
  474.         END IF
  475.       END IF
  476.       IF Co$=CHR$(30) THEN
  477.         Satz=Satz+10
  478.         IF Satz>Msatz THEN
  479.           BEEP
  480.           Satz=Msatz
  481.         END IF
  482.       END IF
  483.       IF Co$="G" THEN
  484.         LOCATE 24,1
  485.         INPUT "Welche Satznummer (* - letzte Nummer) ";N$
  486.         IF N$="*" THEN
  487.           Satz=Msatz
  488.         ELSE
  489.           Satz=ABS(INT(VAL(N$)))
  490.           IF Satz=0 THEN
  491.             Satz=1
  492.             BEEP
  493.           END IF
  494.           IF Satz>Msatz THEN
  495.             Satz=Msatz
  496.             BEEP
  497.           END IF
  498.         END IF
  499.       END IF
  500.       IF Co$="L" THEN
  501.         FOR I=1 TO 11
  502.           LSET In$(I)=""
  503.         NEXT I
  504.         PUT #1,Satz
  505.       END IF
  506.       IF Co$="D" THEN
  507.         IF Drucker=1 THEN
  508.           FOR I=1 TO Anzmsk
  509.             LPRINT Bezeichnung$(I);"  :  ";In$(I)
  510.           NEXT I
  511.           LPRINT
  512.           LPRINT
  513.         END IF
  514.       END IF
  515.       IF Co$="E" THEN
  516.         FOR I=1 TO 11
  517.           Ein$(I)=In$(I)
  518.         NEXT I
  519.         GOSUB Eing
  520.         FOR I=1 TO 11
  521.           LSET In$(I)=Ein$(I)
  522.         NEXT I
  523.         PUT #1,Satz
  524.       END IF
  525.     WEND
  526.     Co$=""
  527.   CLOSE #1   
  528. RETURN
  529.  
  530. Loeschen:
  531.   req$="           Soll das Programm wirklich neu gestartet werden ???"
  532.   REQUESTER req$,req%
  533.   IF req%=1 THEN
  534.     RUN
  535.   END IF
  536.   WINDOW OUTPUT 2
  537. RETURN
  538.  
  539. Ende:
  540.   req$="               Wollen Sie das Programm wirklich beenden ??"
  541.   REQUESTER req$,req%
  542.   IF req%=1 THEN
  543.     WINDOW CLOSE 2
  544.     SCREEN CLOSE 1
  545.     MENU RESET
  546.     LIBRARY CLOSE
  547.     SYSTEM
  548.   END IF
  549.   WINDOW OUTPUT 2
  550. RETURN
  551.  
  552. DruckeAlles:
  553.   CLS
  554.   LINE INPUT "Dateiname ohne Pfadangabe -> ";Dnam$
  555.   Datnam$=Drive$+Pfad$+Dnam$+".DATEN"
  556.   Datinfnam$=Drive$+Pfad$+Dnam$+".INFOS"
  557.   GOSUB LeseInfos
  558.   LPRINT "Dateiname          : ";Dnam$
  559.   LPRINT "Anzahl Datensätze  :";Satznummer-1
  560.   LPRINT "Ausgedruckt am     : ";
  561.   Datum DTM$
  562.   LPRINT DTM$
  563.   LPRINT "Uhrzeit            : ";TIME$
  564.   LPRINT
  565.   LPRINT
  566.   CLS       
  567.   OPEN "r",#1,Datnam$,550
  568.     FIELD #1,Laenge(1) AS In$(1),Laenge(2) AS In$(2),Laenge(3) AS In$(3),Laenge(4) AS In$(4),Laenge(5) AS In$(5),Laenge(6) AS In$(6),Laenge(7) AS In$(7),Laenge(8) AS In$(8),Laenge(9) AS In$(9),Laenge(10) AS In$(10),Laenge(11) AS In$(11)
  569.     PRINT "Daten ausdrucken..."
  570.     PRINT "Aktueller Datensatz : "
  571.     FOR I=1 TO Satznummer-1
  572.       LOCATE 5,5
  573.       PRINT I
  574.       GET #1,I
  575.       FOR Ii=1 TO Anzmsk
  576.         LPRINT Bezeichnung$(Ii);" : ";
  577.         LPRINT In$(Ii)
  578.       NEXT Ii
  579.       LPRINT 
  580.     NEXT I
  581.   CLOSE #1
  582.   LPRINT
  583.   LPRINT
  584.   LPRINT "--- Ende der Datei ---"
  585.   LPRINT
  586.   LPRINT
  587.   LPRINT
  588. RETURN
  589.  
  590. DruckeAllesOHNE:
  591.   CLS
  592.   LINE INPUT "Dateiname ohne Pfadangabe -> ";Dnam$
  593.   Datnam$=Drive$+Pfad$+Dnam$+".DATEN"
  594.   Datinfnam$=Drive$+Pfad$+Dnam$+".INFOS"
  595.   GOSUB LeseInfos
  596.   OPEN "r",#1,Datnam$,550
  597.     FIELD #1,Laenge(1) AS In$(1),Laenge(2) AS In$(2),Laenge(3) AS In$(3),Laenge(4) AS In$(4),Laenge(5) AS In$(5),Laenge(6) AS In$(6),Laenge(7) AS In$(7),Laenge(8) AS In$(8),Laenge(9) AS In$(9),Laenge(10) AS In$(10),Laenge(11) AS In$(11)
  598.     PRINT "Daten ausdrucken..."
  599.     PRINT "Aktueller Datensatz : "
  600.     FOR I=1 TO Satznummer-1
  601.       LOCATE 5,5
  602.       PRINT I
  603.       GET #1,I
  604.       FOR Ii=1 TO Anzmsk
  605.         LPRINT In$(Ii)
  606.       NEXT Ii
  607.       LPRINT 
  608.     NEXT I
  609.   CLOSE #1
  610.   LPRINT
  611.   LPRINT
  612. RETURN
  613.  
  614. DruckeAuswahl:
  615.   CLS
  616.   LINE INPUT "Dateiname ohne Pfadangabe -> ";Dnam$
  617.   INPUT "Satznummer ";Satz
  618.   Datnam$=Drive$+Pfad$+Dnam$+".DATEN"
  619.   Datinfnam$=Drive$+Pfad$+Dnam$+".INFOS"
  620.   GOSUB LeseInfos
  621.   LPRINT "Dateiname      :";Datnam$
  622.   LPRINT "Satznummer     ;";Satz
  623.   LPRINT
  624.   OPEN "r",#1,Datnam$,550
  625.     FIELD #1,Laenge(1) AS In$(1),Laenge(2) AS In$(2),Laenge(3) AS In$(3),Laenge(4) AS In$(4),Laenge(5) AS In$(5),Laenge(6) AS In$(6),Laenge(7) AS In$(7),Laenge(8) AS In$(8),Laenge(9) AS In$(9),Laenge(10) AS In$(10),Laenge(11) AS In$(11)
  626.     GET #1,Satz
  627.     FOR I=1 TO Anzmsk
  628.       LPRINT Bezeichnung$(I);"  :  ";
  629.       LPRINT In$(I)
  630.     NEXT I
  631.   CLOSE #1
  632.   LPRINT
  633.   LPRINT
  634. RETURN
  635.  
  636. ChangeDir:
  637.   WINDOW 5,"Bitte Pfadnamen eingeben : ",(1,20)-(400,30),16,1
  638.   LINE INPUT Pfad$
  639.   WINDOW CLOSE 5
  640.   WINDOW OUTPUT 2
  641.   IF Pfad$<>"" THEN
  642.     l=LEN(Pfad$)
  643.     IF MID$(Pfad$,l,1)<>"/" THEN
  644.       Pfad$=Pfad$+"/"
  645.       l=l+1
  646.     END IF
  647.     IF MID$(Pfad$,1,1)=":" THEN
  648.       Pfad$=MID$(Pfad$,2,l-1)
  649.     END IF
  650.     IF MID$(Pfad$,4,1)=":" THEN
  651.       Drive$=MID$(Pfad$,1,4)
  652.       Pfad$=MID$(Pfad$,5,l-4)
  653.     END IF
  654.   ELSE
  655.     Pfad$="MaxiDAT/Daten/"
  656.   END IF
  657. RETURN
  658.  
  659. ChangeDrive:
  660.   req$="               Welches Laufwerk ?  <JA> = "+d1$+"; <NEIN> = "+d2$
  661.   REQUESTER req$,Lw%
  662.   IF Lw%=1 THEN
  663.     Drive$=d1$
  664.   ELSE
  665.     Drive$=d2$
  666.   END IF
  667.   WINDOW OUTPUT 2
  668. RETURN
  669.  
  670. ZeigeDir:
  671.   WINDOW 6,"DIRECTORY VON DRIVE "+Drive$+", DIRECTORY "+Pfad$,,0,1
  672.   Inhalt$=Drive$+MID$(Pfad$,1,LEN(Pfad$)-1)
  673.   FILES Inhalt$
  674.   PRINT 
  675.   PRINT "-- Taste drücken --"
  676.   WHILE INKEY$=""
  677.   WEND
  678.   WINDOW CLOSE 6
  679.   WINDOW OUTPUT 2
  680. RETURN
  681.  
  682. DeleteFile:
  683.   CLS
  684.   LINE INPUT "Name (ohne Pfad- u. Laufwerksangabe) ? ";Dnam$
  685.   IF Dnam$<>"" THEN
  686.     Dnam$=Drive$+Pfad$+Dnam$
  687.     req$="                Soll dieses File wirklich gelöscht werden ???"
  688.     REQUESTER req$,req%
  689.     WINDOW OUTPUT 2
  690.     IF req%=1 THEN
  691.       KILL Dnam$
  692.     END IF
  693.   END IF
  694. RETURN
  695.  
  696. GrafikdateiAnlegen:
  697.   GOSUB LoescheVariablen
  698.   CLS
  699.   PRINT "Datei anlegen..."
  700.   LINE INPUT "Name (ohne Pfad- u. Laufwerksangabe) ? ";Nam$
  701.   IF Nam$="" THEN
  702.     RETURN
  703.   END IF
  704.   Datinfnam$=Drive$+Pfad$+Nam$+".INFOS"
  705.   OPEN Datinfnam$ FOR OUTPUT AS #2
  706.     WRITE #2,11          
  707.     WRITE #2,2
  708.     WRITE #2,1
  709.     WRITE #2,"Bezeichnung"
  710.     WRITE #2,5
  711.     WRITE #2,"Wert"
  712.     WRITE #2,5
  713.   CLOSE #2
  714. RETURN
  715.   
  716. Zeichnen:
  717.   GOSUB LoescheVariablen
  718.   CLS
  719.   M=0
  720.   PRINT "Balkengrafik zeichnen"
  721.   LINE INPUT "Dateiname ? ";Nam$
  722.   IF Nam$="" THEN
  723.     RETURN
  724.   END IF
  725.   Datnam$=Drive$+Pfad$+Nam$+".DATEN"
  726.   Datinfnam$=Drive$+Pfad$+Nam$+".INFOS"
  727.   GOSUB LeseInfos
  728.   CLS
  729.   IF gr THEN
  730.     ERASE b$
  731.     ERASE W
  732.   END IF
  733.   gr=1
  734.   INPUT "Höchster y-Wert ";M$
  735.   M=VAL(M$)
  736.   CLS 
  737.   DIM b$(Satznummer),W(Satznummer)
  738.   OPEN "R",#1,Datnam$,550
  739.     FIELD #1,Laenge(1) AS In$(1),Laenge(2) AS In$(2),Laenge(3) AS In$(3),Laenge(4) AS In$(4),Laenge(5) AS In$(5),Laenge(6) AS In$(6),Laenge(7) AS In$(7),Laenge(8) AS In$(8),Laenge(9) AS In$(9),Laenge(10) AS In$(10),Laenge(11) AS In$(11)
  740.     FOR I=1 TO Satznummer-1
  741.       GET #1,I
  742.       b$(I)=In$(1)
  743.       W(I)=VAL(In$(2))
  744.     NEXT I
  745.     LOCATE 1,1
  746.     PRINT M
  747.     LOCATE 16,1
  748.     PRINT M/2
  749.     ScaleY=350/M
  750.     ScaleX=INT(550/(Satznummer-1))
  751.     COLOR 3
  752.     FOR I=1 TO 640 STEP 10
  753.       LINE (I,0)-(I,400)
  754.     NEXT I
  755.     FOR I=1 TO 400 STEP 10
  756.       LINE (0,I)-(640,I)
  757.     NEXT I   
  758.     FOR I=1 TO Satznummer-1
  759.       COLOR 1
  760.       LINE ((I*ScaleX)+3,300-W(I)*ScaleY)-(((I+1)*ScaleX)-3,350),,bf
  761.       COLOR 3,1
  762.       LOCATE 32,3+INT((I*ScaleX)/8)
  763.       PRINT b$(I);
  764.     NEXT I
  765.     COLOR 1,0
  766.   CLOSE #1
  767.   WHILE INKEY$=""
  768.   WEND  
  769.   CLS
  770. RETURN
  771.   
  772. ProgrammInfo:
  773.   CLS
  774.   LOCATE 1,1
  775.   Txt$="MaxiDAT - AMIGA"
  776.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  777.   LOCATE 2,1  
  778.   Txt$="---------------"
  779.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  780.   LOCATE 4,1
  781.   Txt$="Version 2.20, geschrieben Mai 1989 von Christoph Hust"
  782.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  783.   LOCATE 6,1
  784.   Txt$="Änderung zu Version 2.10:"
  785.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  786.   LOCATE 7,1
  787.   Txt$="Schnellere Textausgabe, Uhr im Hauptmenü läuft endlich, Fehler verbessert,"
  788.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  789.   LOCATE 8,1
  790.   Txt$="Config-Datei."
  791.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  792.   LOCATE 10,1
  793.   Txt$="Wenn Ihnen das Programm gefällt, bitte senden Sie ungefähr 20 DM an"
  794.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  795.   LOCATE 11,1
  796.   Txt$="folgende Adresse:"
  797.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  798.   LOCATE 13,1 
  799.   Txt$="        CHRISTOPH HUST"
  800.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  801.   LOCATE 14,1
  802.   Txt$="        MAINZER STRASSE 30"
  803.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  804.   LOCATE 15,1
  805.   Txt$="        D-5407 BOPPARD 1"
  806.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  807.   LOCATE 17,1
  808.   COLOR 2 
  809.   Txt$="MAXIDAT IST EIN PUBLIC DOMAIN PROGRAMM. ES DARF FREI KOPIERT WERDEN."
  810.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  811.   COLOR 1
  812.   LOCATE 19,1
  813.   Txt$="----- Taste drücken ----- Taste drücken ----- Taste drücken -----"
  814.   CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  815.   WHILE INKEY$=""
  816.   WEND
  817. RETURN
  818.  
  819. REM ******************************************************************
  820. REM *** Hier stehen die Unterprogramme, die von mehreren Programm- ***
  821. REM *** funktionen aus aufgerufen werden                           ***
  822. REM ******************************************************************
  823.  
  824. Eing:
  825.   WHILE Jn$<>"J"
  826.     CLS
  827.     LOCATE 1,1
  828.     Txt$="Daten eingeben.        Satznummer:"+STR$(Satz)
  829.     CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  830.     FOR I=1 TO Anzmsk
  831.       COLOR 3
  832.       LOCATE I+2,1
  833.       Txt$=Bezeichnung$(I)+":"
  834.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  835.       COLOR 2
  836.       LOCATE I+2,Maxbezlaenge+4
  837.       Txt$=Ein$(I)
  838.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  839.     NEXT I
  840.     COLOR 1
  841.     FOR I=1 TO Anzmsk
  842.       LOCATE I+2,Maxbezlaenge+4
  843.       LINE INPUT Eing$
  844.       IF Eing$<>"" THEN
  845.         Ein$(I)=Eing$
  846.       END IF
  847.     NEXT I
  848.     CLS
  849.     LOCATE 1,1
  850.     Txt$="Daten eingeben.        Satznummer:"+STR$(Satz)
  851.     CALL Text(RastPort&,SADD(Txt$),LEN(Txt$)) 
  852.     FOR I=1 TO Anzmsk
  853.       COLOR 3
  854.       LOCATE I+2,1
  855.       Txt$=Bezeichnung$(I)+":"
  856.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  857.       COLOR 2
  858.       LOCATE I+2,Maxbezlaenge+4
  859.       Txt$=Ein$(I)
  860.       CALL Text(RastPort&,SADD(Txt$),LEN(Txt$))
  861.     NEXT I
  862.     COLOR 1
  863.     LOCATE 20,1
  864.     Jn$=""
  865.     INPUT "Eingaben OK ";Jn$
  866.     Jn$=LEFT$(UCASE$(Jn$),1)
  867.   WEND  
  868.   Jn$=""    
  869. RETURN
  870.  
  871. LeseInfos:
  872.   OPEN Datinfnam$ FOR INPUT AS #2
  873.     INPUT #2,Maxbezlaenge
  874.     INPUT #2,Anzmsk
  875.     INPUT #2,Satznummer
  876.     FOR I=1 TO Anzmsk
  877.       LINE INPUT #2,Bezeichnung$(I)
  878.       Bezeichnung$(I)=MID$(Bezeichnung$(I),2,LEN(Bezeichnung$(I))-2)
  879.       INPUT #2,Laenge(I)
  880.     NEXT I
  881.   CLOSE #2
  882. RETURN
  883.  
  884. REM ******************************************************************
  885. REM *** Hier sind einige neue BASIC-"Befehle", die auch in eigenen ***
  886. REM *** Programmen untergebracht werden können                     ***
  887. REM ******************************************************************
  888.  
  889. SUB REQUESTER (Txt$,req%) STATIC
  890.   TIMER STOP:MENU STOP
  891.   a$=CHR$(10)+CHR$(10)+CHR$(10)+Txt$+CHR$(0)+CHR$(255)
  892.   T2$="  LINKE MAUSTASTE : JA                              RECHTE MAUSTASTE : NEIN"
  893.   BEEP
  894.   a$=a$+CHR$(10)+CHR$(10)+CHR$(25)+T2$+CHR$(0)+CHR$(0)
  895.   req%=DisplayAlert%(0,SADD(a$),45)
  896.   TIMER ON:MENU ON
  897. END SUB
  898.  
  899. Datum:
  900.   MENU OFF
  901.     DTM$=MID$(DATE$,4,2)
  902.     DTM$=DTM$+"."
  903.     DTM$=DTM$+MID$(DATE$,1,2)
  904.     DTM$=DTM$+"."
  905.     DTM$=DTM$+MID$(DATE$,7,4)
  906.   MENU ON
  907. RETURN
  908.  
  909. REM ******************************************************
  910. REM *** Diese Routine wird beim Auftritt eines Fehlers ***
  911. REM *** aufgerufen.                                    ***
  912. REM ******************************************************
  913.  
  914. Fehler:
  915.   TIMER OFF
  916.   Fr=ERR
  917.   WINDOW 3,"Fehler aufgetreten:",(1,1)-(400,50),16,1
  918.   WINDOW OUTPUT 3
  919.   PRINT "BASIC-Fehlernummer:";Fr
  920.   PRINT 
  921.   BEEP
  922.   IF Fr=64 THEN
  923.     PRINT "Ungültiger bzw. falscher Dateiname!"
  924.   END IF
  925.   IF Fr=63 THEN
  926.     PRINT "Die zulässige Satznummer ist überschritten!"
  927.   END IF
  928.   IF Fr=77 THEN
  929.     PRINT "Deadlock Error. (???)"
  930.   END IF
  931.   IF Fr=68 THEN
  932.     PRINT "Gerät nicht verfügbar!"
  933.   END IF
  934.   IF Fr=57 THEN
  935.     PRINT "Technische Probleme bei einem I/O-Vorgang!"
  936.   END IF
  937.   IF Fr=61 THEN
  938.     PRINT "Diskette voll!"
  939.   END IF
  940.   IF Fr=58 THEN
  941.     PRINT "Datei existiert bereits!"
  942.   END IF
  943.   IF Fr=55 THEN
  944.     PRINT "Datei ist bereits geöffnet!"
  945.   END IF
  946.   IF Fr=53 THEN
  947.     PRINT "Datei existiert nicht!"
  948.   END IF
  949.   IF Fr=62 THEN
  950.     PRINT "Versuch, nach Dateiende Werte einzulesen!"
  951.   END IF
  952.   IF Fr=51 THEN
  953.     PRINT "Internal Error im AmigaBASIC!"
  954.   END IF
  955.   IF Fr=70 THEN
  956.     PRINT "Erlaubnis verweigert. Wahrscheinlich ist die Disk schreibgeschützt ?"
  957.   END IF
  958.   IF Fr=36 THEN
  959.     PRINT "SUB-Routine bereits im Einsatz!"
  960.   END IF
  961.   IF Fr=13 THEN
  962.     PRINT "Fehlende Typ-Übereinstimmung bei der Parameterübergabe!"
  963.   END IF
  964.   IF Fr=49 THEN
  965.     PRINT "Unbekannte Diskette!"
  966.   END IF
  967.   IF Fr=6 THEN
  968.     PRINT "Zahl zu groß!"
  969.   END IF
  970.   PRINT 
  971.   PRINT "Taste drücken !!"
  972.   WHILE INKEY$=""
  973.   WEND
  974.   WINDOW CLOSE 3
  975.   WINDOW 2
  976.   WINDOW OUTPUT 2
  977.   CLOSE
  978. RESUME Hauptprogramm
  979.  
  980. LoescheVariablen:
  981.   FOR I%=1 TO 11
  982.     Laenge(I%)=0
  983.     Bezeichnung$(I%)=""
  984.   NEXT I%
  985. RETURN
  986.  
  987.